home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
ASMCODE.ZIP
/
TYPES.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-11-02
|
11KB
|
426 lines
{ ────────────────────────────────────────────────────────────────────────
This code is Copyright (c) 1994 by Jonathan E. Wright and AmoebaSoft.
To communicate with the author, send internet mail to: NELNO@DELPHI.COM
About this code:
This code was stripped from my normal global unit and error handler.
I hope I didn't screw anything up.
If you use this code in any of your programs, or as a basis for anything
else you may write, please give credit to Nelno the Amoeba. A postcard
from your country or town would also be nice. Send it to:
Nelno
58 1/2 Woodland Rd.
Asheville, NC 28804-3823
USA
────────────────────────────────────────────────────────────────────────
}
UNIT Types;
Interface
USES
DOS;
CONST
DebugKeys : BOOLEAN = TRUE;
hexChars: array [0..$F] of Char = '0123456789ABCDEF';
DOSErrorMess : ARRAY [2..17] OF STRING [44] =
('Could not locate the requested file.',
'Path not found.',
'Too many files open.',
'File access denied. ',
'Invalid file handle.', '', '', '', '', '',
'Invalid file access code.', '', '',
'Invalid drive number.',
'Cannot remove current directory.',
'Cannot rename accross drives.');
CustErrorMess : ARRAY [18..35] OF STRING [43] =
('Could not perform memory request.',
'File has no palette.',
'File being saved contains color #255.',
'Entry not in library.',
'No EMM manager present.',
'Attempt to allocate EMMblock > 16384 bytes.',
'EMM free list is full in ',
'Too few pages to create requested EMM heap.',
'EMM manager version is below 4.0.',
'Attempt to read past end of file.',
'Sample larger than 65020 bytes.',
'No entries in library directory.',
'Unrecognizable MOD format.',
'Unknown format tag.',
'',
'',
'',
'');
IOErrorMess : ARRAY [100..106] OF STRING [24] =
('Disk read error', 'Disk write error', 'File not assigned',
'File not open', 'File not open for input', 'File not open for output',
'Invalid numeric format');
CriticalErrorMess : ARRAY [150..162] OF STRING [20] =
('Disk is write-protected', 'Unknown unit',
'Drive not ready', 'Unknown command', 'CRC error in data',
'Disk seek error', 'Critical Error #155',
'Unknown media type', 'Sector Not Found', 'Printer out of paper',
'Device write fault', 'Device read fault', 'Hardware failure');
FatalErrorMess : ARRAY [200..214] OF STRING [25] =
('Division by zero', 'Range check error', 'Stack overflow error',
'Heap overflow error', 'Invalid pointer operation',
'Floating point overflow', 'Floating point underflow',
'Invalid F.L.O.P.', 'OVR manager not installed',
'Overlay file read error', 'Object not initialized',
'Call to abstract method', 'Fatal Error #212',
'Fatal Error #213', 'Fatal Error #214');
VAR
OldInt08 : POINTER;
OldInt1C : POINTER;
ErrorMessage : STRING [80];
ErrorCode : WORD;
ErrorAddress : POINTER;
FUNCTION ST (n : LONGINT): STRING;
FUNCTION Raise (n, x : INTEGER): LONGINT;
FUNCTION Exists (FileName : STRING) : BOOLEAN;
PROCEDURE Print (S : STRING; Attribute : BYTE);
FUNCTION HexWord (w : WORD): STRING;
FUNCTION BinWord (n : WORD): STRING;
FUNCTION HexByte (b : BYTE): STRING;
PROCEDURE ErrorHandler (UnitNum, n : WORD); FAR;
IMPLEMENTATION
VAR
SavedExit : POINTER;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE NewExit; FAR;
BEGIN
ExitProc := SavedExit;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION ST (n : LONGINT): STRING;
VAR
S : STRING;
BEGIN
STR (n, S);
ST := S;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION Raise (n, x : INTEGER): LONGINT;
VAR
Count : INTEGER;
n1 : INTEGER;
BEGIN
N1 := n;
IF x = 0 THEN
n := 0
ELSE
FOR Count := 1 to X - 1 DO
N := n * n1;
Raise := n;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION Exists (FileName : STRING) : BOOLEAN;
VAR
InFile : FILE OF BYTE;
BEGIN
ASSIGN (InFile, FileName);
{$I-}
RESET (InFile);
{$I+}
IF IOResult = 0 THEN
Exists := TRUE
ELSE
Exists := FALSE;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE Print (S : STRING; Attribute : BYTE);
VAR
R : REGISTERS;
X, CY : BYTE;
I : INTEGER;
T : CHAR;
BEGIN
R.AH := $03; { get cursor position }
R.BH := 0;
Intr ($10, R);
X := R.DL;
CY := R.DH;
FOR I := 1 to ORD (S [0]) DO
BEGIN
T := S [I];
ASM
mov ah,9
mov al,T
mov bl,Attribute
mov bh,0
mov cx,1
int 10h
END;
INC (X);
IF X > 80 THEN
BEGIN
X := 0;
INC (CY);
IF CY > 24 THEN
BEGIN
ASM
mov ax,0601h
mov cx,0101h
mov dx,1950h
mov bh,07h
int 10h
mov ah,2
mov dl,0
mov dh,24
mov bh,0
int 10h
mov X,0
mov CY,24
END;
END;
END;
ASM
mov ah,2
mov dl,X
mov dh,CY
mov bh,0
int 10h
END;
END;
INC (CY);
IF CY > 24 THEN
BEGIN
ASM
mov ax,0601h
mov cx,0101h
mov dx,1950h
mov bh,07h
int 10h
mov ah,02
mov dl,0
mov dh,24
mov bh,0
int 10h
mov X,0
mov CY,24
END;
END;
ASM
mov ah,2
mov bh,0
mov dl,0
mov dh,CY
int 10h
END;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION HexWord (w : WORD): STRING;
VAR
S : STRING;
BEGIN
S := hexChars [Hi(w) shr 4] + hexChars [Hi(w) and $F] +
hexChars [Lo(w) shr 4] + hexChars [Lo(w) and $F];
HexWord := S;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ FUNCTION BinWord (n : WORD): STRING; ║
║ ║
╟───────────────────────────────────────────────────────────────────────╢
║ ║
║ returns a string containing the binary equivalent of the value of n ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION BinWord (n : WORD): STRING;
VAR
I, Temp : WORD;
S : STRING;
BEGIN
S := ' ';
I := 16;
WHILE (I > 0) DO
BEGIN
Temp := n MOD 2;
n := n DIV 2;
S [I] := CHR (Temp + 48);
DEC (I);
END;
INSERT ('∙', S, 9);
BinWord := S;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION HexByte (b : BYTE): STRING;
VAR
S : STRING;
BEGIN
S := hexChars [b shr 4] + hexChars [b and $F];
HexByte := S;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE ClrScr; ASSEMBLER;
ASM
mov ah,02
xor dx,dx
xor bx,bx
int 10h { set cursor position }
mov ah,09
mov al,20h
xor bx,bx
mov bl,07
mov cx,2000
int 10h
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ Error handler for all units. ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE ErrorHandler (UnitNum, n : WORD);
BEGIN
ASM
mov ax,[bp] { get return address from stack }
mov dx,[bp+02]
mov word ptr ErrorAddress [0],ax
mov word ptr ErrorAddress [2],dx
END;
CASE n OF
2..17 : ErrorMessage := DOSErrorMess [n];
18..35: ErrorMessage := CustErrorMess [n];
100..106:
ErrorMessage := IOErrorMess [n];
150..162:
ErrorMessage := CriticalErrorMess [n];
200..214:
ErrorMessage := FatalErrorMess [n];
ELSE ErrorMessage := 'Unknown';
END;
ErrorCode := n;
Halt (UnitNum);
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
VAR
I : INTEGER;
BEGIN
ErrorAddress := NIL;
ErrorCode := 0;
ErrorMessage := '';
GetIntVec ($1C, OldInt1C);
GetIntVec ($08, OldInt08);
SavedExit := ExitProc;
ExitProc := @NewExit;
ClrScr;
END.